Developer CD Series 2000 August: Tool Chest/Dev.CD Aug 00 TC Disk 2.toast/pc/sample code/human interface toolbox/bigscrolling/bigscrolling.p

Text File | 2000-06-23 | 11.2 KB | 289 lines

{
    File:        BigScrolling.p

    Contains:    ScrollBars are limited in their range to a signed 16-bit number (+/- 32768).
                This project demo's one way to work around this limitation.

    Written by:

    Copyright:    Copyright © 1999 by Apple Computer, Inc., All Rights Reserved.

                You may incorporate this Apple sample source code into your program(s) without
                restriction. This Apple sample source code has been provided "AS IS" and the
                responsibility for its operation is yours. You are not permitted to redistribute
                this Apple sample source code as "Apple sample source code" after having made
                changes. If you're going to re-distribute the source, we require that you make
                it clear in the source that the code was descended from Apple sample source
                code, but that you've made changes.

    Change History (most recent first):
                7/16/1999    Karl Groethe    Updated for Metrowerks Codewarror Pro 2.1


}

unit BigScrolling;

interface
uses
    Traps,Windows,Controls,TextUtils,Fonts;

type

{ We attach this record, which contains longint values for the minimum, maximum and value of the control, to the }
{ control's refcon.  Our "MyGetCtlValue" and "MySetCtlValue" look for a pointer to this record in the control's }
{ refcon so we can find it. }

    bigValues = record
            bigMin: longint;
            bigMax: longint;
            bigValue: longint;
        end;
    bigValuesPtr = ^bigValues;

procedure InitializeApplication;
procedure TerminateApplication;
procedure CloseAppWindow (theWindow: WindowPtr);
procedure DrawWindow (theWindow: WindowPtr; drawingPort: grafPtr; printing: BOOLEAN; isActive: BOOLEAN);
procedure DoContentClick (window: WindowPtr; event: EventRecord);
procedure MySetCtlValue (theControl: ControlHandle; theValue: longint);
function MyGetControlValue (theControl: ControlHandle): longint;
procedure FixMyCtlValue (theControl: ControlHandle);

implementation

var
    ourScrollBar: ControlHandle;

{ MySetCtlValue takes a longint control value.  It stuffs the value into the bigValues record pointed to by the }
{ control refcon and normalizes it into a 0..32767 range for the control's actual value (signed integer).  This}
{ is obviously a loss of precision, but it's OK because this is only used for displaying the thumb position by}
{ the Control Manager. }

procedure MySetCtlValue (theControl: ControlHandle; theValue: longint);

    var
        extendedValue: extended;
        intValue: integer;
        ourValues: bigValuesPtr;


    begin
        ourValues := bigValuesPtr(GetControlReference(theControl));
        with ourValues^ do
            begin

{ We have to pin the value to our minimum and maximum values so we don't underflow or overflow. }

                if theValue > bigMax then
                    bigValue := bigMax
                else if theValue < bigMin then
                    bigValue := bigMin
                else
                    bigValue := theValue;

{ To normalize, we subtract the bigMin from bigMax to get the control's range of values.  Dividing that interval}
{ by 32767 tells us how much our longint control value has to change before the real control value changes by one. }
{ For example, if our range is 0 to 65535, the real control value moves by one every time our value changes}
{ by two.  Once we have that interval, we divide our real value by it to get a normalized value. }
{ (our Value)/(interval / 32767) is the same as (ourValue * 32767) / interval, which is the form we use.}
{ 32767 is expressed as 32767.0 so extended calculations are done, to avoid overflow even for really big}
{ values. }

                extendedValue := (((bigValue - bigMin) * 32767.0) / (bigMax - bigMin));
                                                                                        { this will always be between 0 and 32767 }
                intValue := round(extendedValue);                                            { explicitly truncate to integer }
                SetControlValue(theControl, intValue);
            end;    {with}
    end;

{ FixMyCtlValue resets bigValue to something resembling the actual control value, for those occasions when the }
{ Control Manager drags the thumb for you and resets the value based on the min and max fields in the control }
{ record.   It reverses the MySetCtlValue calculation to get an approximation of where the big control value is for }
{ the place where the user dragged the thumb; this is the best we can do because the scroll bar is never going to get}
{ the resolution of the values (you can't have a scroll bar one million pixels tall).  In the special case that they're at }
{ the very bottom of the scroll bar, we set the value to bigMax so it's more consistent with what users expect. }
{ Since each step in the real control value represents many steps in ours, if the new control value is the same as }
{ where the old bigValue would put it, we don't change it.  This means if you click on the thumb but don't move it, }
{ the control value doesn't change. We have to use extended arithmetic here as well to avoid round-off errors.}

procedure FixMyCtlValue (theControl: ControlHandle);

    var
        allegedValue, intValue: integer;
        oldBigValue: longint;
        ourValues: bigValuesPtr;
        extendedValue, newBigExtended: extended;

    begin
        ourValues := bigValuesPtr(GetControlReference(theControl));
        allegedValue := GetControlValue(theControl);
        with ourValues^ do
            begin
                oldBigValue := bigValue;
{ To reverse the calculation, we divide the interval of possible values by the maximum real control value, then multiply }
{ that by the value the Control Manager has.  Since the minimum might not be zero, we add it in as well. }

                newBigExtended := (((((bigMax - bigMin) / 32767.0)) * allegedValue) + bigMin);
                bigValue := round(newBigExtended);

                        { Now, if that new bigValue has the same CtlValue as the old bigValue, restore the old one. }

                extendedValue := (((oldBigValue - bigMin) * 32767.0) / (bigMax - bigMin));
                                                                                        { this will always be between 0 and 32767 }
                intValue := round(extendedValue);                                            { explicitly truncate to integer }
                if intValue = allegedValue then
                    bigValue := oldBigValue
                else if allegedValue = 32767 then
                    bigValue := bigMax                                        { pin to bottom only if not changing value otherwise }

            end;   { with }
    end;              { procedure }

procedure InitializeApplication;
    var
        theWindow: WindowPtr;
        newValuesPtr: bigValuesPtr;

    begin

{ Create and show our window }

        theWindow := GetNewWindow(128, nil, Pointer(-1));        { window is invisible in the WIND resource }
        ourScrollBar := GetNewControl(128, theWindow);
        newValuesPtr := bigValuesPtr(NewPtr(sizeof(bigValues)));
        newValuesPtr^.bigMin := 0;                                                { an arbitrary minimum }
        newValuesPtr^.bigMax := 1500000;                                    { an arbitrary maximum }
        SetControlReference(ourScrollBar, longint(newValuesPtr));            { put a pointer to the record in the control's refCon}
        MySetCtlValue(ourScrollBar, 1000000);                            { an arbitrary initial value }
        ShowWindow(theWindow);

    end;

procedure TerminateApplication;                                            { Called by Sample.p -- not needed in this unit }
    begin
    end;

procedure CloseAppWindow (theWindow: WindowPtr);

    begin
        DisposePtr(Ptr(GetControlReference(ourScrollBar)));                        { Dispose of our bigValues structure }
        CloseWindow(theWindow);                                                    { and close the window. }
    end;

procedure DrawTheValue (theValue: longint);

    var
        tempString: Str255;
        myRect: Rect;
    begin
        SetRect(myRect, 40, 40, 150, 100);                                { an arbitrary sized rectangle to draw in }
        EraseRect(myRect);
        MoveTo(50, 50);
        TextFont(kFontIDGeneva);
        NumToString(theValue, tempString);                                    { turn the value into a string }
        DrawString(tempString);
    end;
{ MyGetCtlValue returns our longint value from the bigValues record attached to the refcon.  There's no calculation}
{ to do here, because MySetCtlValue and FixMyCtlValue does all that for us. }

function MyGetControlValue (theControl: ControlHandle): longint;

    var
        ourValues: bigValuesPtr;

    begin
        ourValues := bigValuesPtr(GetControlReference(theControl));
        MyGetControlValue := ourValues^.bigValue;
    end;

{ This procedure is called by the shell-like Sample.p file to draw windows.  Sample.p sets "printing" to TRUE if }
{ it's printing (though this snippet doesn't print), so we ignore that.  We also ignore "isActive" because in this }
{ program, we have one window and it's always active, and we ignore "drawingPort" because it's NIL unless we're }
{ printing, in which case it's the printing grafPort.  All we have to do in this routine is call DrawControls to draw}
{ our scroll bar, then call DrawTheValue to provide an integer representation of it. }

procedure DrawWindow (theWindow: WindowPtr; drawingPort: grafPtr; printing: boolean; isActive: boolean);
    var
        oldPort: grafPtr;
        theValue: longint;
    begin
        GetPort(oldPort);
        SetPort(theWindow);
        DrawControls(theWindow);
        theValue := MyGetControlValue(ourScrollBar);
        DrawTheValue(theValue);
        SetPort(oldPort);
    end;

{ NonThumbAction is the action routine we pass to TrackControl when the user clicks on the scroll arrows or page}
{ region of the scroll bar.  We add arbitrary values to the control value, then call MySetCtlValue to change the }
{ control's value and redraw it.  We then draw the value after retrieving it again -- we retrieve it with MyGetControlValue }
{ just in case our last change would have gone under the minimum or over the maximum.  MySetCtlValue prevents that, }
{ and we get the corrected value before displaying it. }

procedure NonThumbAction (theControl: ControlHandle; partCode: integer);

    var
        ourValue: longint;

    const
        arrowUpAmount = -1;
        arrowDownAmount = 1;
        pageUpAmount = -1000;
        pageDownAmount = 1000;

    begin
        ourValue := MyGetControlValue(theControl);

        case partCode of
            kControlUpButtonPart:
                ourValue := ourValue + arrowUpAmount;
            kControlDownButtonPart:
                ourValue := ourValue + arrowDownAmount;
            kControlPageUpPart:
                ourValue := ourValue + pageUpAmount;
            kControlPageDownPart:
                ourValue := ourValue + pageDownAmount;
        end;
        MySetCtlValue(theControl, ourValue);
        DrawTheValue(MyGetControlValue(theControl));            { in case it got pinned to the minimum or maximum }
    end;

{ Sample.p calls DoContentClick when it finds a click in the content region of an app window (that's us).  Since all }
{ we care about is the scroll bar, we call FindControl and then TrackControl, passing NonThumbAction if they click}
{ in the scroll bar (but not in the thumb), and passing NIL if they click in the thumb.  If they dragged the thumb, we}
{ use FixMyCtlValue to repair the bigValue in our private record on the refcon. }

procedure DoContentClick (window: WindowPtr; event: EventRecord);
    var
        thePartCode, theNewPartCode: integer;
        ourLocalPoint: Point;
        ourControl: ControlHandle;
        oldPort: grafPtr;

    begin
        GetPort(oldPort);
        SetPort(window);
        ourLocalPoint := event.where;
        GlobalToLocal(ourLocalPoint);
        thePartCode := FindControl(ourLocalPoint, window, ourControl);
        case thePartCode of
            0:
                ;
                     { we get and ignore zero if they mouse up outside the part they mouse down-ed in }
            kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart, kControlPageDownPart:
                theNewPartCode := TrackControl(ourControl, ourLocalPoint, NewControlActionProc(ControlActionProcPtr(@NonThumbAction)));
            kControlIndicatorPart:
                begin
                    theNewPartCode := TrackControl(ourControl, ourLocalPoint, nil);
                    FixMyCtlValue(ourControl);                { change bigValue to match to where they moved the thumb }
                    DrawTheValue(MyGetControlValue(ourControl));
                end;
        end;                { case thePartCode of }
        SetPort(oldPort);

    end;


end.